#loading library and dataset
library(tidyverse)
library(plotly)
library(sf)
library(htmlwidgets)
setwd("D:/Downloads/dataviz_mini-project_02")
Warning: The working directory was changed to D:/Downloads/dataviz_mini-project_02 inside a notebook chunk. The working directory will be reset when the chunk is finished running. Use the knitr root.dir option in the setup chunk to change the working directory for notebook chunks.
data <- read_csv("https://raw.githubusercontent.com/reisanar/datasets/master/fifa18.csv")
Rows: 17076 Columns: 40── Column specification ────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────
Delimiter: ","
chr (3): name, nationality, club
dbl (37): age, overall, potential, acceleration, aggression, agility, balance, ball_control, composure, crossing, curve, dribbling, finishing, free_kick_accuracy, gk_diving, gk_han...
ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
data
world_shapes <- read_sf("data/ne_110m_admin_0_countries/ne_110m_admin_0_countries.shp")
world_shapes
Simple feature collection with 177 features and 94 fields
Geometry type: MULTIPOLYGON
Dimension: XY
Bounding box: xmin: -180 ymin: -90 xmax: 180 ymax: 83.64513
Geodetic CRS: WGS 84
# Interactive Plot - Overall vs age of the top 100 players
# firstly, wrangling data.
perf_summary <- data %>%
summarise(name, age, overall) %>%
arrange(desc(overall)) %>%
slice_head(n = 100)
Warning: Returning more (or less) than 1 row per `summarise()` group was deprecated in dplyr 1.1.0.
Please use `reframe()` instead.
When switching from `summarise()` to `reframe()`, remember that `reframe()` always returns an ungrouped data frame and adjust accordingly.
perf_summary
# Next, plotting data
perf_plot <- perf_summary %>%
ggplot(aes(x = age, y = overall)) +
geom_point() +
labs(x = "Age (years)", y = "Overall Performance Score") +
geom_point(aes(text = name))
Warning: Ignoring unknown aesthetics: text
perf_plot

perf_plotly <- ggplotly(perf_plot)
perf_plotly
saveWidget(perf_plotly, "perfPlot.html", selfcontained = TRUE)
# Spatial Plot - birthplaces of top 10 to 20 players on the world map, along with top 3 best stats.
# Firstly, Wrangling data.
Top20summary <- data %>%
arrange(desc(overall)) %>%
slice_max(overall, n = 20) %>%
mutate(Top_3_Categories = pmap_chr(select(., -club, -name, -age, -nationality, -overall), function(...) {
values <- c(...)
value_names <- names(values)
top_n <- value_names[order(values, decreasing = TRUE)][1:3]
paste("Top 3 Categories:", paste(top_n, collapse = ", "))
})) %>%
rename(c(NAME_LONG = nationality)) %>%
select(name, age, NAME_LONG, overall, Top_3_Categories)
Top20summary
# next, plotting on the world map. countries will be colored if they have a top 20 player of that nationality.
top20_map <- world_shapes %>%
left_join(Top20summary, by = "NAME_LONG")
ggplot() +
geom_sf(data = top20_map, aes(fill = ifelse(!is.na(overall), "Yes", "No"))) +
scale_fill_manual(values = c("Yes" = "lightblue", "No" = "darkgray")) +
labs(title = "Countries with Top 20 FIFA 2018 Characters",
fill = "Top 20 Player from Country") +
theme_minimal()

NA
NA
# Model Plot - free_kick_accuracy score as a function of finishing score for top 100 players.
# firstly, wrangling data.
kick_summary <- data %>%
summarise(name, age, free_kick_accuracy, finishing) %>%
arrange(desc(finishing)) %>%
slice_head(n = 100)
Warning: Returning more (or less) than 1 row per `summarise()` group was deprecated in dplyr 1.1.0.
Please use `reframe()` instead.
When switching from `summarise()` to `reframe()`, remember that `reframe()` always returns an ungrouped data frame and adjust accordingly.
kick_summary
kick_plot <- kick_summary %>%
ggplot(aes(x = finishing, y = free_kick_accuracy)) +
geom_point() +
geom_smooth(method = "lm",
formula = "y ~ x") +
theme_minimal() +
labs(x = "Finishing Score", y = "Free Kick Accuracy Score")
kick_plot

NA
NA
LS0tDQp0aXRsZTogIkRhdGEgVmlzdWFsaXphdGlvbiAtIE1pbmktUHJvamVjdCAyIg0KYXV0aG9yOiAiTWljaGFlbCBDb29tYnMgYG1jb29tYnM3OTcxQGZsb3JpZGFwb2x5LmVkdWAiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpgYGB7cn0NCiNsb2FkaW5nIGxpYnJhcnkgYW5kIGRhdGFzZXQNCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShwbG90bHkpDQpsaWJyYXJ5KHNmKQ0KbGlicmFyeShodG1sd2lkZ2V0cykNCg0Kc2V0d2QoIkQ6L0Rvd25sb2Fkcy9kYXRhdml6X21pbmktcHJvamVjdF8wMiIpDQpkYXRhIDwtIHJlYWRfY3N2KCJodHRwczovL3Jhdy5naXRodWJ1c2VyY29udGVudC5jb20vcmVpc2FuYXIvZGF0YXNldHMvbWFzdGVyL2ZpZmExOC5jc3YiKQ0KZGF0YQ0Kd29ybGRfc2hhcGVzIDwtIHJlYWRfc2YoImRhdGEvbmVfMTEwbV9hZG1pbl8wX2NvdW50cmllcy9uZV8xMTBtX2FkbWluXzBfY291bnRyaWVzLnNocCIpDQoNCndvcmxkX3NoYXBlcw0KDQpgYGANCg0KYGBge3J9DQojIEludGVyYWN0aXZlIFBsb3QgLSBPdmVyYWxsIHZzIGFnZSBvZiB0aGUgdG9wIDEwMCBwbGF5ZXJzDQojIGZpcnN0bHksIHdyYW5nbGluZyBkYXRhLg0KcGVyZl9zdW1tYXJ5IDwtIGRhdGEgJT4lDQogIHN1bW1hcmlzZShuYW1lLCBhZ2UsIG92ZXJhbGwpICU+JQ0KICBhcnJhbmdlKGRlc2Mob3ZlcmFsbCkpICAlPiUNCiAgc2xpY2VfaGVhZChuID0gMTAwKQ0KDQpwZXJmX3N1bW1hcnkNCg0KIyBOZXh0LCBwbG90dGluZyBkYXRhDQoNCnBlcmZfcGxvdCA8LSBwZXJmX3N1bW1hcnkgJT4lDQogIGdncGxvdChhZXMoeCA9IGFnZSwgeSA9IG92ZXJhbGwpKSArDQogIGdlb21fcG9pbnQoKSArDQogIGxhYnMoeCA9ICJBZ2UgKHllYXJzKSIsIHkgPSAiT3ZlcmFsbCBQZXJmb3JtYW5jZSBTY29yZSIpICsNCiAgZ2VvbV9wb2ludChhZXModGV4dCA9IG5hbWUpKQ0KDQpwZXJmX3Bsb3QNCg0KcGVyZl9wbG90bHkgPC0gZ2dwbG90bHkocGVyZl9wbG90KQ0KcGVyZl9wbG90bHkNCnNhdmVXaWRnZXQocGVyZl9wbG90bHksICJwZXJmUGxvdC5odG1sIiwgc2VsZmNvbnRhaW5lZCA9IFRSVUUpDQpgYGANCg0KYGBge3J9DQojIFNwYXRpYWwgUGxvdCAtIGJpcnRocGxhY2VzIG9mIHRvcCAxMCB0byAyMCBwbGF5ZXJzIG9uIHRoZSB3b3JsZCBtYXAsIGFsb25nIHdpdGggdG9wIDMgYmVzdCBzdGF0cy4NCiMgRmlyc3RseSwgV3JhbmdsaW5nIGRhdGEuDQpUb3AyMHN1bW1hcnkgPC0gZGF0YSAlPiUNCiAgYXJyYW5nZShkZXNjKG92ZXJhbGwpKSAlPiUNCiAgc2xpY2VfbWF4KG92ZXJhbGwsIG4gPSAyMCkgJT4lDQogIG11dGF0ZShUb3BfM19DYXRlZ29yaWVzID0gcG1hcF9jaHIoc2VsZWN0KC4sIC1jbHViLCAtbmFtZSwgLWFnZSwgLW5hdGlvbmFsaXR5LCAtb3ZlcmFsbCksIGZ1bmN0aW9uKC4uLikgew0KICAgIHZhbHVlcyA8LSBjKC4uLikNCiAgICB2YWx1ZV9uYW1lcyA8LSBuYW1lcyh2YWx1ZXMpDQogICAgdG9wX24gPC0gdmFsdWVfbmFtZXNbb3JkZXIodmFsdWVzLCBkZWNyZWFzaW5nID0gVFJVRSldWzE6M10NCiAgICBwYXN0ZSgiVG9wIDMgQ2F0ZWdvcmllczoiLCBwYXN0ZSh0b3BfbiwgY29sbGFwc2UgPSAiLCAiKSkNCiAgfSkpICU+JQ0KICByZW5hbWUoYyhOQU1FX0xPTkcgPSBuYXRpb25hbGl0eSkpICU+JQ0KICBzZWxlY3QobmFtZSwgYWdlLCBOQU1FX0xPTkcsIG92ZXJhbGwsIFRvcF8zX0NhdGVnb3JpZXMpDQoNCg0KVG9wMjBzdW1tYXJ5DQoNCiMgbmV4dCwgcGxvdHRpbmcgb24gdGhlIHdvcmxkIG1hcC4gY291bnRyaWVzIHdpbGwgYmUgY29sb3JlZCBpZiB0aGV5IGhhdmUgYSB0b3AgMjAgcGxheWVyIG9mIHRoYXQgbmF0aW9uYWxpdHkuDQoNCnRvcDIwX21hcCA8LSB3b3JsZF9zaGFwZXMgJT4lDQogIGxlZnRfam9pbihUb3AyMHN1bW1hcnksIGJ5ID0gIk5BTUVfTE9ORyIpIA0KDQpnZ3Bsb3QoKSArDQogIGdlb21fc2YoZGF0YSA9IHRvcDIwX21hcCwgYWVzKGZpbGwgPSBpZmVsc2UoIWlzLm5hKG92ZXJhbGwpLCAiWWVzIiwgIk5vIikpKSArDQogIHNjYWxlX2ZpbGxfbWFudWFsKHZhbHVlcyA9IGMoIlllcyIgPSAibGlnaHRibHVlIiwgIk5vIiA9ICJkYXJrZ3JheSIpKSArDQogIGxhYnModGl0bGUgPSAiQ291bnRyaWVzIHdpdGggVG9wIDIwIEZJRkEgMjAxOCBDaGFyYWN0ZXJzIiwNCiAgICAgICBmaWxsID0gIlRvcCAyMCBQbGF5ZXIgZnJvbSBDb3VudHJ5IikgKw0KICB0aGVtZV9taW5pbWFsKCkgDQoNCg0KYGBgDQoNCmBgYHtyfQ0KIyBNb2RlbCBQbG90IC0gZnJlZV9raWNrX2FjY3VyYWN5IHNjb3JlIGFzIGEgZnVuY3Rpb24gb2YgZmluaXNoaW5nIHNjb3JlIGZvciB0b3AgMTAwIHBsYXllcnMuDQojIGZpcnN0bHksIHdyYW5nbGluZyBkYXRhLg0Ka2lja19zdW1tYXJ5IDwtIGRhdGEgJT4lDQogIHN1bW1hcmlzZShuYW1lLCBhZ2UsIGZyZWVfa2lja19hY2N1cmFjeSwgZmluaXNoaW5nKSAlPiUNCiAgYXJyYW5nZShkZXNjKGZpbmlzaGluZykpICAlPiUNCiAgc2xpY2VfaGVhZChuID0gMTAwKQ0KDQpraWNrX3N1bW1hcnkNCg0Ka2lja19wbG90IDwtIGtpY2tfc3VtbWFyeSAlPiUNCiAgZ2dwbG90KGFlcyh4ID0gZmluaXNoaW5nLCB5ID0gZnJlZV9raWNrX2FjY3VyYWN5KSkgKw0KICBnZW9tX3BvaW50KCkgKw0KICBnZW9tX3Ntb290aChtZXRob2QgPSAibG0iLCANCiAgICAgICAgICAgICAgZm9ybXVsYSA9ICJ5IH4geCIpICsgDQogIHRoZW1lX21pbmltYWwoKSArDQogIGxhYnMoeCA9ICJGaW5pc2hpbmcgU2NvcmUiLCB5ID0gIkZyZWUgS2ljayBBY2N1cmFjeSBTY29yZSIpDQoNCg0Ka2lja19wbG90DQoNCg0KYGBg